home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / strings.swg / 0102_Text-Device with PChars.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-26  |  3.4 KB  |  140 lines
  1. {
  2. this unit implements a text-device that links to a PChar string. When you
  3. want to use a Pascal string, you can patch it, or convert your string to
  4. PChar before using it. An example is included.
  5. From: master@alterdial.uu.net (Nick Vermeulen)
  6. }
  7. Unit StrDev;
  8. (*
  9.     This unit allows string manipulation with standard Read/Write proc's,
  10.     using dataconversion and variable parameter-count as implemented by
  11.     Read/Write proc's.
  12.  
  13.     example:
  14.  
  15.     Uses Strings, StrDev;
  16.  
  17.     Var  f: Text;
  18.          s: Array[0..30] of Char;
  19.          i: Integer;
  20.  
  21.     Begin
  22.       AssignStrDevice(f, s, SizeOf(s));  { link s to f }
  23.       Rewrite(f);                        { s will be overwritten }
  24.       i := 12;
  25.       Write(f, 'testing', i:12);         { write string + integer to s }
  26.       Close(f);                          { NEEDED! buffer flushes to s }
  27.       WriteLn(s);                        { show result }
  28.       Append(f);                         { demonstrate appending }
  29.       Write(f, 'appending!');            { try to make s smaller! }
  30.       Close(f);
  31.       WriteLn(s);
  32.       StrCopy(s, '1 2 3');               { fill s with data }
  33.       Reset(f);                          { open for reading }
  34.       While not Eof(f) Do
  35.       Begin
  36.         Read(f, i);                      { read integers from s }
  37.         WriteLn(i);
  38.       End;
  39.       Close(f);
  40.     End.
  41. *)
  42.  
  43. Interface
  44.  
  45. Uses Strings, Dos;
  46.  
  47. Procedure AssignStrDevice(var T: Text; aStr: PChar; aSize: Word);
  48.  
  49. Implementation
  50.  
  51. Type
  52.   UData = Record          { typecasted over device's UserData (16 bytes) }
  53.             Str  : PChar; { 4 bytes, string to use }
  54.             Size : Word;  { 2 bytes, size of the string }
  55.             p    : PChar; { 4 bytes, current pos in string }
  56.             fill : array[1..6] of byte;
  57.           End;
  58.  
  59. Function WindowRead(var F: TextRec): Integer; far;
  60. {}
  61. Begin
  62.   With F, UData(UserData) Do
  63.   Begin
  64.     BufEnd := StrEnd(Str)-p;
  65.     If (BufEnd > BufSize) Then
  66.       BufEnd := BufSize;
  67.     BufPos := 0;
  68.     StrLCopy(PChar(BufPtr), p, BufEnd);
  69.     Inc(p, BufEnd);
  70.     WindowRead := 0;
  71.   End;
  72. End;
  73.  
  74. Function WindowWrite(var F: TextRec): Integer; far;
  75. {}
  76. Begin
  77.   With F, UData(UserData) do
  78.   Begin
  79.     StrLCopy(p, PChar(BufPtr), Size-(p-Str)-1);
  80.     Inc(p, Size-(p-Str)-1);
  81.     BufPos := 0;
  82.   End;
  83.   WindowWrite := 0;
  84. End;
  85.  
  86. Function WindowOpen(var F: TextRec): Integer; far;
  87. {}
  88. Begin
  89.   WindowOpen := 0;
  90.   With F, UData(UserData) do
  91.   Begin
  92.     Case Mode of
  93.       fmInput:
  94.         Begin
  95.           InOutFunc := @WindowRead;
  96.           FlushFunc := nil;
  97.           p         := Str;
  98.         End;
  99.       fmInOut:
  100.         Begin
  101.           InOutFunc := @WindowWrite;
  102.           FlushFunc := nil;
  103.           Mode      := fmOutput;
  104.           p         := StrEnd(Str);
  105.         End;
  106.       fmOutput:
  107.         Begin
  108.           InOutFunc  := @WindowWrite;
  109.           FlushFunc  := nil;
  110.           p          := Str;
  111.         End;
  112.     End;
  113.   End;
  114. End;
  115.  
  116. Function WindowClose(var F: TextRec): Integer; far;
  117. {}
  118. Begin
  119.   WindowClose := 0;
  120. End;
  121.  
  122. Procedure AssignStrDevice(var T: Text; aStr: PChar; aSize: Word);
  123. {}
  124. Begin
  125.   With TextRec(T), UData(UserData) do
  126.   Begin
  127.     Handle := $FFFF;
  128.     Mode := fmClosed;
  129.     BufSize := SizeOf(Buffer);
  130.     BufPtr := @Buffer;
  131.     Str := aStr;
  132.     Size := aSize;
  133.     OpenFunc := @WindowOpen;
  134.     CloseFunc := @WindowClose;
  135.   End;
  136. End;
  137.  
  138. End.
  139.  
  140.